R Notebook

library(tidyverse)

-- Attaching packages -------------------------------------------------------------------------------------------------------------------- tidyverse 1.3.0 --
v tibble  3.1.0     v stringr 1.4.0
v readr   1.4.0     v forcats 0.5.1
-- Conflicts ----------------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
x purrr::%||%()       masks flexclust.golem::%||%()
x purrr::accumulate() masks foreach::accumulate()
x dplyr::filter()     masks stats::filter()
x purrr::is_null()    masks testthat::is_null()
x dplyr::lag()        masks stats::lag()
x tidyr::matches()    masks dplyr::matches(), testthat::matches()
x MASS::select()      masks dplyr::select()
x purrr::when()       masks foreach::when()

library(flexclust)
library(flexclust.golem)

params$solutions

flexclust.golem::plot_profile(params$solutions,1)

plot_profile...
class solutions:tbl_dftbldata.frame
class solutions$fit_km:list
class solutions$fit_km[1]:list
class solutions$fit_km[1][[1]]:kcca
i = 1

NULL

  i=1
  this_solution = params$solutions$fit_km[i][[1]]
  k <- this_solution@k
  seed = params$solutions$seed[i]
  pop_av_dist <- with(this_solution@clusinfo, sum(size*av_dist)/sum(size))
  main_txt <- paste("kcca ", "Av Dist = ", format(pop_av_dist, digits = 5), params$method, " - ",k,"seed=",seed)
  
  label_clust <- hclust(dist(t(as.matrix(data_df))))
  
  barchart(this_solution, 
           which=label_clust$order,
           main = main_txt, strip.prefix = "#",
           scales = list(cex = 0.6),
           shade = TRUE,
           legend = TRUE,
           clusters=5:6
  )

NULL

  this_solution

kcca object of family ‘ejaccard’ 

call:
flexclust::stepFlexclust(x = as.matrix(data_df), k = 6L, nrep = km_nrep, FUN = flexclust::kcca, seed = seed, multicore = FALSE, 
    family = flexclust::kccaFamily(method))

cluster sizes:

  1   2   3   4   5   6 
362 434  92 343 227 542 

var_labels

 [1] "cash_1"                                 "platform_unknown"                       "shop_before_covid_1"                   
 [4] "person_marital_status_unknown"          "tenure_group_0_1"                       "site_type_shop"                        
 [7] "enroll_site_type_shop"                  "weekend_1"                              "age_group_30_40"                       
[10] "tenure_group_5_10"                      "site_type_migration"                    "enroll_site_type_migration"            
[13] "age_group_40_50"                        "tenure_group_3_5"                       "discount_3_20_percent_30_percent"      
[16] "annual_spend_3_2mn_3mn"                 "discount_4_30_percent_40_percent"       "age_group_12_20"                       
[19] "person_gender_m"                        "annual_spend_4_3mn_5mn"                 "tenure_group_10_20"                    
[22] "age_group_50_60"                        "pay_with_points_4_more_than_124_points" "annual_spend_5_5mn_10mn"               
[25] "discount_5_40_percent_50_percent"       "site_type_mobile_apps"                  "enroll_site_type_mobile_apps"          
[28] "platform_i_phone_os"                    "pay_with_points_2_31_59_points"         "bazar_before_covid_1"                  
[31] "bazar_1"                                "traveller_1"                            "discount_6_above_50_percent"           
[34] "age_group_unknown"                      "site_type_online"                       "enroll_site_type_online"               
[37] "site_type_test_market"                  "enroll_site_type_test_market"           "petition_1"                            
[40] "annual_spend_6_above_10mn"              "reach_tbs_voice_1"                      "bazar_after_covid_1"                   
[43] "age_group_60_100"                       "others_1"                               "reach_tbs_webchat_1"                   
[46] "posted_reviews_1"                       "annual_spend_unknown"                   "pay_with_points_unknown"               
[49] "discount_unknown"                       "reach_tbs_wa_1"                         "pay_with_points_3_60_124_points"       
[52] "abandon_basket_1"                       "online_before_covid_1"                  "credit_1"                              
[55] "bbob_1"                                 "point_redeemer_1"                       "tenure_group_1_3"                      
[58] "discount_2_10_percent_20_percent"       "annual_spend_2_1mn_2mn"                 "donation_1"                            
[61] "sustainability_score_1"                 "debit_1"                                "shop_after_covid_1"                    
[64] "person_marital_status_single"           "online_after_covid_1"                   "working_1"                             
[67] "age_group_20_30"                       

plot_data %>% 
  ggplot() +
  geom_point(aes(x=variable, y=all),col="black") +
  geom_segment(aes(x=variable, y=0, xend=variable, yend=all),col="black") +
  geom_col(aes(x=variable, y=solution, fill=I(shade)),alpha=0.5) +
  coord_flip() +
  facet_wrap(~segment) +
  ylab("Proportion of Segment") 

ggplot(data=plot_data %>% filter(part == "all", segment=="1"), aes(x=variable,y=value)) + 
  geom_col() + 
  geom_point(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=value)) +
  geom_segment(data=plot_data %>% filter(part == "solution", segment=="1"), aes(x=variable, y=0, xend=variable, yend=value)) +
  facet_wrap(~segment) + coord_flip()